VERSION 5.00
Begin VB.Form Form1
Caption = "Form1"
ClientHeight = 3195
ClientLeft = 5850
ClientTop = 4125
ClientWidth = 4680
LinkTopic = "Form1"
ScaleHeight = 3195
ScaleWidth = 4680
Begin VB.CommandButton Command1
Caption = "Solve"
Height = 975
Left = 1080
TabIndex = 0
Top = 840
Width = 2295
End
End
Attribute VB_Name = "Form1"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
' A VB programming example of interfacing with the
' LINDO API.
'
' the problem:
'
' Max = 20 * A + 30 * C
' S.T. A + 2 * C <= 120
' A <= 60
' C <= 50
'
' Solving such a problem with the LINDO API involves
' the following steps:
'
' 1. Create a LINDO environment.
' 2. Create a model in the environment.
' 3. Specify the model.
' 4. Perform the optimization.
' 5. Retrieve the solution.
' 6. Delete the LINDO environment.
Option Explicit
Private Sub Command1_Click()
'Declarations
Dim con_type As String
Dim env As Long
Dim errorcode As Long
Dim i As Long
Dim m As Long
Dim n As Long
Dim nz As Long
Dim prob As Long
Dim Abegcol() As Long
Dim Arowndx() As Long
Dim Acoef() As Double
Dim b() As Double
Dim c() As Double
Dim obj As Double
Dim x(3) As Double
'>>> Step 1 <<<: Create a LINDO environment.
env = LScreateEnv(errorcode, MY_LICENSE_KEY)
If (errorcode > 0) Then
MsgBox ("Unable to create environment.")
End
End If
'>>> Step 2 <<<: Create a model in the environment.
prob = LScreateModel(env, errorcode)
Call CheckErr(env, errorcode)
'>>> Step 3 <<<: Specify the model.
'Set the problem sizes
'number of constraints
m = 3
'number of variables
n = 2
'objective coefficients
ReDim c(n)
c(0) = 20
c(1) = 30
'right-hand-sides of constraints
ReDim b(m)
b(0) = 120
b(1) = 60
b(2) = 50
'constraint types
con_type = "LLL"
'index of first nonzero in each column
ReDim Abegcol(n + 1)
Abegcol(0) = 0
Abegcol(1) = 2
Abegcol(2) = 4
'number of nonzeros in constraint matrix
nz = 4
'the nonzero coefficients
ReDim Acoef(nz)
Acoef(0) = 1
Acoef(1) = 1
Acoef(2) = 2
Acoef(3) = 1
'the row indices of the nonzeros
ReDim Arowndx(nz)
Arowndx(0) = 0
Arowndx(1) = 1
Arowndx(2) = 0
Arowndx(3) = 2
errorcode = LSloadLPData(prob, m, n, LS_MAX, 0, _
c(0), b(0), con_type, nz, Abegcol(0), ByVal 0, _
Acoef(0), Arowndx(0), ByVal 0, ByVal 0)
Call CheckErr(env, errorcode)
'Establish the callback function
errorcode = LSsetCallback(prob, AddressOf MyCallback, ByVal 0)
'>>> Step 4 <<<: Perform the optimization.
errorcode = LSoptimize(prob, LS_METHOD_PSIMPLEX)
Call CheckErr(env, errorcode)
'>>> Step 5 <<<: Retrieve the solution.
'Print the objective value and primals
errorcode = LSgetObjective(prob, obj)
Call CheckErr(env, errorcode)
errorcode = LSgetPrimalSolution(prob, x(0))
Call CheckErr(env, errorcode)
MsgBox ("Objective value: " & obj & vbCrLf & _
"Primal values: " & x(0) & " " & x(1))
'>>> Step 6 <<<: Delete the LINDO environment
Call LSdeleteEnv(env)
End Sub
Public Sub CheckErr(env As Long, errorcode As Long)
' Checks for an error condition. If one exists, the
' error message is displayed then the application
' terminates.
If (errorcode > 0) Then
Dim message As String
message = String(LS_MAX_ERROR_MESSAGE_LENGTH, _
vbNullChar)
Call LSgetErrorMessage(env, errorcode, message)
MsgBox (message)
End
End If
End Sub
File Callback.bas:
Attribute VB_Name = "Module3"
Public Function MyCallback(ByVal model As Long, _
ByVal loc As Long, ByRef myData As Long) As Long
Dim it As Long
Dim ob As Double
Call LSgetCallbackInfo(model, loc, LS_IINFO_ITER, it)
Call LSgetCallbackInfo(model, loc, LS_DINFO_POBJ, ob)
MsgBox "In MyCallback" & vbCrLf & "Iteration: " _
& it & vbCrLf & "Objective value: " & ob
MyCallback = 0
End Function
|